home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Ham Radio 2000
/
Ham Radio 2000.iso
/
ham2000
/
misc
/
dspice0s
/
reserv.c
< prev
next >
Wrap
C/C++ Source or Header
|
1992-11-21
|
6KB
|
195 lines
/* reserv.f -- translated by f2c (version of 3 February 1990 3:36:42).
You must link the resulting object file with the libraries:
-lF77 -lI77 -lm -lc (in that order)
*/
#include "f2c.h"
/* Common Block Declarations */
struct {
integer ielmnt, isbckt, nsbckt, iunsat, nunsat, itemps, numtem, isens,
nsens, ifour, nfour, ifield, icode, idelim, icolum, insize,
junode, lsbkpt, numbkp, iorder, jmnode, iur, iuc, ilc, ilr,
numoff, isr, nmoffc, iseq, iseq1, neqn, nodevs, ndiag, iswap,
iequa, macins, lvnim1, lx0, lvn, lynl, lyu, lyl, lx1, lx2, lx3,
lx4, lx5, lx6, lx7, ld0, ld1, ltd, imynl, imvn, lcvn, nsnod,
nsmat, nsval, icnod, icmat, icval, loutpt, lpol, lzer, irswpf,
irswpr, icswpf, icswpr, irpt, jcpt, irowno, jcolno, nttbr, nttar,
lvntmp;
} tabinf_;
#define tabinf_1 tabinf_
struct {
integer iprnta, iprntl, iprntm, iprntn, iprnto, limtim, limpts, lvlcod,
lvltim, itl1, itl2, itl3, itl4, itl5, itl6, igoof, nogo, keof;
} flags_;
#define flags_1 flags_
struct {
doublereal value[200000];
} blank_;
#define blank_1 blank_
/* Table of constant values */
static integer c__1 = 1;
/*< subroutine reserv (node1,node2) >*/
/* Subroutine */ int reserv_(node1, node2)
integer *node1, *node2;
{
/* System generated locals */
integer i_1;
/* Local variables */
static integer loci, locj, isize;
#define nodplc ((integer *)&blank_1)
#define cvalue ((complex *)&blank_1)
extern logical memptr_();
extern /* Subroutine */ int sizmem_();
static integer newloc;
extern /* Subroutine */ int extmem_();
static integer loc;
/*< implicit double precision (a-h,o-z) >*/
/* this routine records the fact that the (node1, node2) element of */
/* the circuit equation coefficient matrix is nonzero. */
/* spice version 2g.6 sccsid=tabinf 3/15/83 */
/*< common /tabinf/ ielmnt,isbckt,nsbckt,iunsat,nunsat,itemps,numtem, >*/
/*< 1 isens,nsens,ifour,nfour,ifield,icode,idelim,icolum,insize, >*/
/*< 2 junode,lsbkpt,numbkp,iorder,jmnode,iur,iuc,ilc,ilr,numoff,isr, >*/
/*< 3 nmoffc,iseq,iseq1,neqn,nodevs,ndiag,iswap,iequa,macins,lvnim1, >*/
/*< 4 lx0,lvn,lynl,lyu,lyl,lx1,lx2,lx3,lx4,lx5,lx6,lx7,ld0,ld1,ltd, >*/
/*< 5 imynl,imvn,lcvn,nsnod,nsmat,nsval,icnod,icmat,icval, >*/
/*< 6 loutpt,lpol,lzer,irswpf,irswpr,icswpf,icswpr,irpt,jcpt, >*/
/*< 7 irowno,jcolno,nttbr,nttar,lvntmp >*/
/* spice version 2g.6 sccsid=flags 3/15/83 */
/*< common /flags/ iprnta,iprntl,iprntm,iprntn,iprnto,limtim,limpts, >*/
/*< 1 lvlcod,lvltim,itl1,itl2,itl3,itl4,itl5,itl6,igoof,nogo,keof >*/
/* spice version 2g.6 sccsid=blank 3/15/83 */
/*< common /blank/ value(200000) >*/
/*< integer nodplc(64) >*/
/*< complex cvalue(32) >*/
/*< equivalence (value(1),nodplc(1),cvalue(1)) >*/
/*< logical memptr >*/
/*< if (nogo.ne.0) go to 300 >*/
if (flags_1.nogo != 0) {
goto L300;
}
/* ... test for ground */
/*< if (node1.eq.1) go to 300 >*/
if (*node1 == 1) {
goto L300;
}
/*< if (node2.eq.1) go to 300 >*/
if (*node2 == 1) {
goto L300;
}
/* reserve (node1,node2) in row node1 at col posn node2 */
/*< loc=node1 >*/
loc = *node1;
/*< 10 locj=loc >*/
L10:
locj = loc;
/*< loc=nodplc(jcpt+loc) >*/
loc = nodplc[tabinf_1.jcpt + loc - 1];
/*< if (loc.eq.0) go to 20 >*/
if (loc == 0) {
goto L20;
}
/*< if (nodplc(jcolno+loc)-node2) 10,300,20 >*/
if ((i_1 = nodplc[tabinf_1.jcolno + loc - 1] - *node2) < 0) {
goto L10;
} else if (i_1 == 0) {
goto L300;
} else {
goto L20;
}
/*< 20 call sizmem(jcpt,isize) >*/
L20:
sizmem_(&tabinf_1.jcpt, &isize);
/*< newloc=isize+1 >*/
newloc = isize + 1;
/*< nodplc(numoff+node1)=nodplc(numoff+node1)+1 >*/
++nodplc[tabinf_1.numoff + *node1 - 1];
/*< nodplc(nmoffc+node2)=nodplc(nmoffc+node2)+1 >*/
++nodplc[tabinf_1.nmoffc + *node2 - 1];
/*< call extmem(jcpt,1) >*/
extmem_(&tabinf_1.jcpt, &c__1);
/*< call extmem(jcolno,1) >*/
extmem_(&tabinf_1.jcolno, &c__1);
/*< nodplc(jcpt+locj)=newloc >*/
nodplc[tabinf_1.jcpt + locj - 1] = newloc;
/*< nodplc(jcpt+newloc)=loc >*/
nodplc[tabinf_1.jcpt + newloc - 1] = loc;
/*< nodplc(jcolno+newloc)=node2 >*/
nodplc[tabinf_1.jcolno + newloc - 1] = *node2;
/* reserve (node1,node2) in col node2 at row posn node1 */
/*< loc=node2 >*/
loc = *node2;
/*< 30 loci=loc >*/
L30:
loci = loc;
/*< loc=nodplc(irpt+loc) >*/
loc = nodplc[tabinf_1.irpt + loc - 1];
/*< if (loc.eq.0) go to 40 >*/
if (loc == 0) {
goto L40;
}
/*< if (nodplc(irowno+loc)-node1) 30,300,40 >*/
if ((i_1 = nodplc[tabinf_1.irowno + loc - 1] - *node1) < 0) {
goto L30;
} else if (i_1 == 0) {
goto L300;
} else {
goto L40;
}
/*< 40 call extmem(irpt,1) >*/
L40:
extmem_(&tabinf_1.irpt, &c__1);
/*< call extmem(irowno,1) >*/
extmem_(&tabinf_1.irowno, &c__1);
/*< nodplc(irpt+loci)=newloc >*/
nodplc[tabinf_1.irpt + loci - 1] = newloc;
/*< nodplc(irpt+newloc)=loc >*/
nodplc[tabinf_1.irpt + newloc - 1] = loc;
/*< nodplc(irowno+newloc)=node1 >*/
nodplc[tabinf_1.irowno + newloc - 1] = *node1;
/* mark diagonal */
/*< if (node1.ne.node2) go to 300 >*/
if (*node1 != *node2) {
goto L300;
}
/*< if (memptr(ndiag)) nodplc(ndiag+node1)=1 >*/
if (memptr_(&tabinf_1.ndiag)) {
nodplc[tabinf_1.ndiag + *node1 - 1] = 1;
}
/* finished */
/*< 300 return >*/
L300:
return 0;
/*< end >*/
} /* reserv_ */
#undef cvalue
#undef nodplc